Sandbox Profile Language version l\n\n;;; Directives\n\n; ; Define a pair of 
lists of file dependencies; the car is a list of files that\n;; were successfully 
opened for reading, and the cdr is a list of files that\n;; could not be opened for 
reading. These dependencies are used to determine\n; ; when a cached profile is 
invalid. The pair is set to #f if any files were\n;; opened for writing (because 
profiles that write to disk cannot be cached)\n;; or if the full path to a file 
opened for reading cannot be determined . \n(define *dependencies* (cons '() 

' ( ) ) ) \n ; ; Wrap standard I/O procedures to update the dependency lists. \n(let ((old- 

load load)\n (old-open-input-file open-input-file)\n (old-open-output- 

file open-output-file)\n ;; Add an element to a list if the element is not 

already in the listAn (push-unique (lambda (elt lst)\n 

(let loop ((remaining lst))\n (cond\n 

((null? remaining) (cons elt lst))\n ((equal? elt (car 

remaining)) lst)\n (else (loop (cdr remaining) )))))) )\n 

(set! load\n (lambda (path)\n (set! *dependencies*\n 

(and *dependencies*\n (< 0 (string-length path))\n 

(eqv? #\\/ (string-ref path 0))\n (cons (push-unique path (car 

*dependencies*) )\n (cdr *dependencies* ) ) ) )\n 

(old-load path)))\n (set! open-input-file\n (lambda (path)\n (let 

((port (old-open-input-file path)))\n (set! *dependencies*\n 

(and *dependencies*\n (< 0 (string-length path))\n 

(eqv? #\\/ (string-ref path 0))\n (if port\n 

(cons (push-unique path (car *dependencies* ) )\n 

(cdr dependencies* ) )\n (cons (car *dependencies*)\n 

(push-unique path (cdr *dependencies* ) ) ) ) ) )\n port)))\n (set! open- 

output-file\n (lambda (path)\n (set! *dependencies* #f)\n 

(old-open-output-file path))))\n;; Define the import directive . \n(define (import 
path)\n (define import-dirs\n (if (param \"IMPORT_DIR\" )\n (list 

(param \"IMPORT_DIR\" ) )\n (list \"/System/Library/Sandbox/Profiles\"\n 

\"/usr/share/sandbox\"\n \"/Library/Sandbox/Profiles\" ) ) )\n (if (or 

(= 0 (string-length path))\n (eqv? #\\/ (string-ref path 0)))\n ;; 

Absolute path, load it directly. \n (load path)\n ;; Relative path, search 

import-dirs An (let search ((dirs import-dirs) )\n (if (null? dirs)\n 

(error (string-append Y'unable to open \" path)))\n ;; Attempt to open the 

path relative to the next dir in the listAn (let* ((try (string-append (car 

dirs)\n \"/\"\n 

path))\n (tried (open-input-file try)))\n ;; Load the file 

if it could be opened, otherwise keep searching. \n (if tried\n 

(begin (close-input-port tried)\n (load try))\n 

(search (cdr dirs)))))))\n\n; ; Define the trace directive An(define *trace* 
#f)\n(define (trace path)\n (cond\n ((not (string? path))\n (error Y'argument 
to trace must be a string\"))\n (*trace*\n (error Y'only one trace path may be 
specified\"))\n (else\n (set! *trace* path))))\n\n; ; Define the record 
directive An(define *record* #f)\n(define (record path)\n (set! *record* 
path))\n\n;; Define directives for optimizing the compiled sandbox 
profile An(define *eliminate-duplicate-rules* #f)\n(define (eliminate-duplicate- 
rules)\n (set! *eliminate-duplicate-rules* #t))\n\n;; Define directives for 
configuring sandbox options An(define *callouts* #t)\n(define *f ull-symbolication* 
#t)\n(define (disable-callouts)\n (set! *callouts* #f ) )\n(define (disable-full- 
symbolication)\n (set! *f ull-symbolication* #f))\n\n;;; Actions\n\n; ; The %remove 
function returns the elements of a list not satisfying a\n;; predicate An(define 
(%remove pred lst)\n (cond\n ((null? lst)\n lst)\n ((pred (car lst))\n 
(%remove pred (cdr lst)))\n (else\n (cons (car lst)\n (%remove pred 

(cdr lst))))))\n\n; ; The %action function takes the name of an action and returns a 
function\n;; that performs the job of that action . \n(define (%action a)\n ;; 
Collect an unordered list of rule arguments into a list of operations, \n ;; 
filters, and modifiersAn (define (collect 1 o f m)\n (cond\n ((null? l)\n 
(list o f m))\n ((list? (car l))\n (case (caar l)\n ((operation) 

(collect (cdr 1) (cons (car 1) o) f m))\n ((filter ) (collect (cdr 1) o 



(cons (car 1) f) m))\n ((modifier ) (collect (cdr 1) o f (cons (car 1) 

m)))\n (else (error V'illegal argument:\" (car l)))))\n (else\n 

(error \"illegal argument:\" (car l)))))\n (lambda args\n (let* ((collected 
(collect args '() '() '()))\n (os (car collected) )\n ;; If 

there are multiple filter arguments, combine them into a\n ; ; single any 

filter. If there are no filter arguments, use #t.\n (fs (if (pair? (cadr 

collected) )\n (apply require-any (cadr collected) )\n 

#t))\n (ms (%remove (lambda (m)\n (eq? 

'deprecated (%m/name m)))\n (caddr collected) )) )\n ;; 

Verify that at least one operation was provided. \n (if (null? os)\n 

(error \"at least one operation required\"))\n ;; Verify that no modifier 

appears more than once and every modifier\n ;; applies to this action. \n 

(let check-modifiers ((check ms)\n (seen '()))\n 

(if (pair? check)\n (let ((m (car check)))\n (cond\n 

((memq (%m/name m)\n seen)\n (error (string- 

append\n (symbol->string (%m/name m))\n 

\" modifier can only appear once per rule\")))\n ((not ((%m/check m) 

a))\n (error (string-append\n (symbol->string 

(%m/name m))\n \" modifier does not apply to \"\n 

(symbol->string a)\n \" actionV ) ) )\n (else\n 

(check-modifiers (cdr check)\n (cons (%m/name m)\n 

seen) ) ) ) ) ) )\n ;; Iterate through the provided operations . \n (do 

((remaining os (cdr remaining) ) )\n ((null? remaining) )\n (define o 

(car remaining) )\n (define rules (vector-ref *rules* (%o/code 

o)))\n ;; Verify that the filter applies to this operation. \n ;; This 

operates recursively on combination filters. \n (define (check-filter f)\n 


(if (not (eq? #t f))\n 
(map check-filter (%f/args f))\n 
(%o/filters o)))\n 
(symbol->string (%f/type f))\n 
apply to \"\n 


(if (eq? 'combination (%f/type f))\n 

(if (not (memq (%f/type f)\n 
(error (string-append\n 

\" filter does not 
(symbol->string (%o/name o))\n 
V operation\"))))))\n (check-filter fs)\n ;; Verify that each 

modifier applies to this operation. \n (define (check-modifier m)\n 

(if (not (memq (%m/name m)\n (%o/modifiers o)))\n 

(error (string-append\n (symbol->string (%m/name m))\n 

\" modifier does not apply to \"\n (symbol->string (%o/name 

o))\n \" operation\"))))\n (map check-modifier ms)\n 

;; Add the rule into the rule table. \n (cond\n ((eq? #t fs)\n 

;; Replace the unconditional ruleAn (vector-set! *rules*\n 

(%o/code o)\n (reverse (cons (cons #t (cons a ms))\n 

(cdr (reverse rules) )))) )\n ((and (pair? (caar rules))\n 

(equal? (cdar rules)\n (cons a ms)))\n ;; Combine 

the filter with the last ruleAn (set-car! (car rules)\n 

(require-any fs (caar rules))))\n (else\n ;; Insert a new ruleAn 

(vector-set! *rules*\n (%o/code o)\n 

(cons (cons fs (cons a ms))\n rules) )))))) )\n\n; ; 

Define the SBPL actions. \n(define allow (%action ' allow) )\n(define deny (%action 
'deny))\n\n; ; ; Operations\n\n; ; Operations have the form (operation name code 
filters . modifiers)\n; ; e.g. (operation file* (path) (send-signal no-report) 1 
0)\n(define %o/name cadr) ; operation name\n(define %o/code 

caddr) ; operation code\n(define %o/filters cadddr) ; 

compatible filters\n(define %o/modifiers cddddr) ; compatible 

modifiers\n\n; ; The %operations macro takes a list of operations and defines 
them.\n(macro (%operations form)\n (define (operation name filters modifiers 
action code . ancestors)\n '(begin\n (define , name '(operation , name , code 

, filters . , modifiers) )\n (vector-set! *rules*\n ,code\n 

(list ',(if action\n (list #t action)\n 

(cons #f (car ancestors) ))) )\n (vector-set! Operations* ,code ,name)))\n 

'(begin\n ;; Define the rule table. \n (define *rules* 



(make-vector , (length (cdr form))))\n ;; Define a table of all the 
operations . \n (define ‘operations* (make-vector , (length (cdr 
form))))\n An ;; Define each operation, priming the rule table with jumps 
to more\n ;; general operations when no default action is given An , (map 
(lambda (o)\n (apply operation o))\n (cdr form) ) ) )\n\n; ; 

Invoke the %operations macro An(%operations\n (default\n (debug-mode 
entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n deny\n 0)\n (appleevent-send\n (debug-mode entitlement 
extension process ae-destination)\n (send-signal report no-report deprecated 
rootless)\n #f\n 1 0)\n (authorization-right-obtain\n (debug-mode 
entitlement extension process auth-right-name)\n (send-signal report no-report 
deprecated rootless)\n #f\n 2 0)\n (device*\n (debug-mode entitlement 
extension process)\n (send-signal report no-report deprecated rootless)\n 
#f\n 3 0)\n (device-camera\n (debug-mode entitlement extension process)\n 
(send-signal report no-report deprecated rootless)\n #f\n 4 3 0)\n (device- 

microphone\n (debug-mode entitlement extension process)\n (send-signal report 
no-report deprecated rootless)\n #f\n 5 3 0)\n (distributed-notification- 
post\n (debug-mode entitlement extension process notification)\n (send-signal 
report no-report deprecated rootless)\n #f\n 6 0)\n (file*\n (debug-mode 
entitlement extension process path file-mode vnode-type device)\n (send-signal 
report no-report deprecated rootless)\n #f\n 7 0)\n (file-chroot\n 

(debug-mode entitlement extension process path file-mode vnode-type device)\n 
(send-signal report no-report deprecated rootless)\n #f\n 8 7 0)\n (file- 

ioctl\n (debug-mode entitlement extension process path file-mode vnode-type 
device ioctl)\n (send-signal report no-report deprecated rootless)\n #f\n 
9 7 0)\n (file-issue-extension\n (debug-mode entitlement extension process path 
file-mode vnode-type device extension-class)\n (send-signal report no-report 
deprecated rootless)\n #f\n 10 7 0)\n (file-mknod\n (debug-mode 
entitlement extension process path file-mode vnode-type device)\n (send-signal 
report no-report deprecated rootless)\n #f\n 11 7 0)\n (file-mount\n 

(debug-mode entitlement extension process path file-mode vnode-type device)\n 
(send-signal report no-report deprecated rootless)\n #f\n 12 7 0)\n (file- 

read*\n (debug-mode entitlement extension process path file-mode vnode-type 
device cache-safe)\n (send-signal report no-report deprecated rootless)\n 
#f\n 13 7 0)\n (file-read-data\n (debug-mode entitlement extension process 
path file-mode vnode-type device cache-safe)\n (send-signal report no-report 
deprecated rootless)\n #f\n 14 13 7 0)\n (file-read-metadata\n (debug- 
mode entitlement extension process path file-mode vnode-type device cache-safe)\n 
(send-signal report no-report deprecated rootless)\n #f\n 15 13 7 0)\n 

(file-read-xattr\n (debug-mode entitlement extension process path file-mode 
vnode-type device cache-safe xattr)\n (send-signal report no-report deprecated 
rootless)\n #f\n 16 13 7 0)\n (file-revoke\n (debug-mode entitlement 
extension process path file-mode vnode-type device)\n (send-signal report no- 
report deprecated rootless)\n #f\n 17 7 0)\n (file-search\n (debug-mode 
entitlement extension process path file-mode vnode-type device)\n (send-signal 
report no-report deprecated rootless)\n #f\n 18 7 0)\n (file-unmount\n 
(debug-mode entitlement extension process path file-mode vnode-type device)\n 
(send-signal report no-report deprecated rootless)\n #f\n 19 7 0)\n (file- 

write*\n (debug-mode entitlement extension process path file-mode vnode-type 
device)\n (send-signal report no-report deprecated rootless)\n #f\n 20 7 
0)\n (file-write-create\n (debug-mode entitlement extension process path file- 
mode vnode-type device)\n (send-signal report no-report deprecated rootless)\n 
#f\n 21 20 7 0)\n (file-write-data\n (debug-mode entitlement extension 
process path file-mode vnode-type device)\n (send-signal report no-report 
deprecated rootless)\n #f\n 22 20 7 0)\n (file-write-flags\n (debug-mode 
entitlement extension process path file-mode vnode-type device)\n (send-signal 
report no-report deprecated rootless)\n #f\n 23 20 7 0)\n (file-write-mode\n 
(debug-mode entitlement extension process path file-mode vnode-type device)\n 
(send-signal report no-report deprecated rootless)\n #f\n 24 20 7 0)\n 



(file-write-owner\n (debug-mode entitlement extension process path file-mode 
vnode-type device)\n (send-signal report no-report deprecated rootless)\n 
#f\n 25 20 7 0)\n (file-write-setugid\n (debug-mode entitlement extension 

process path file-mode vnode-type device)\n (send-signal report no-report 

deprecated rootless)\n #f\n 26 20 7 0)\n (file-write-times\n (debug-mode 
entitlement extension process path file-mode vnode-type device)\n (send-signal 
report no-report deprecated rootless)\n #f\n 27 20 7 0)\n (file-write- 
unlink\n (debug-mode entitlement extension process path file-mode vnode-type 
device)\n (send-signal report no-report deprecated rootless)\n #f\n 28 20 
7 0)\n (file-write-xattr\n (debug-mode entitlement extension process path file- 
mode vnode-type device xattr)\n (send-signal report no-report deprecated 
rootless)\n #f\n 29 20 7 0)\n (generic-issue-extension\n (debug-mode 
entitlement extension process extension-class)\n (send-signal report no-report 
deprecated rootless)\n #f\n 30 0)\n (qtn-user\n (debug-mode entitlement 
extension process path)\n (send-signal report no-report deprecated rootless)\n 
#f\n 31 0)\n (qtn-download\n (debug-mode entitlement extension process 
path)\n (send-signal report no-report deprecated rootless)\n #f\n 32 0)\n 
(qtn-sandbox\n (debug-mode entitlement extension process path)\n (send-signal 
report no-report deprecated rootless)\n #f\n 33 0)\n (hid-control\n 
(debug-mode entitlement extension process)\n (send-signal report no-report 
deprecated rootless)\n #f\n 34 0)\n (iokit*\n (debug-mode entitlement 
extension process)\n (send-signal report no-report deprecated rootless)\n 
#f\n 35 0)\n (iokit-issue-extension\n (debug-mode entitlement extension 
process extension-class)\n (send-signal report no-report deprecated rootless)\n 
#f\n 36 35 0)\n (iokit-open\n (debug-mode entitlement extension process 
iokit-user-client iokit-connection)\n (send-signal report no-report deprecated 
rootless)\n #f\n 37 35 0)\n (iokit-set-properties\n (debug-mode 
entitlement extension process iokit-property iokit-user-client iokit-connection)\n 
(send-signal report no-report deprecated rootless)\n #f\n 38 35 0)\n (iokit- 

get-properties\n (debug-mode entitlement extension process iokit-property iokit- 
user-client iokit-connection)\n (send-signal report no-report deprecated 
rootless)\n allow\n 39 35 0)\n (ipc*\n (debug-mode entitlement extension 
process)\n (send-signal report no-report deprecated rootless)\n #f\n 40 
0)\n (ipc-posix*\n (debug-mode entitlement extension process posix-ipc)\n 
(send-signal report no-report deprecated rootless)\n #f\n 41 40 0)\n (ipc- 

posix-issue-extension\n (debug-mode entitlement extension process posix-ipc 
extension-class)\n (send-signal report no-report deprecated rootless)\n #f\n 

42 41 40 0)\n (ipc-posix-sem\n (debug-mode entitlement extension process posix- 
ipc semaphore)\n (send-signal report no-report deprecated rootless)\n #f\n 

43 41 40 0)\n (ipc-posix-shm*\n (debug-mode entitlement extension process 

posix-ipc)\n (send-signal report no-report deprecated rootless)\n #f\n 44 

41 40 0)\n (ipc-posix-shm-read*\n (debug-mode entitlement extension process 
posix-ipc)\n (send-signal report no-report deprecated rootless)\n #f\n 45 

44 41 40 0)\n (ipc-posix-shm-read-data\n (debug-mode entitlement extension 
process posix-ipc)\n (send-signal report no-report deprecated rootless)\n 
#f\n 46 45 44 41 40 0)\n (ipc-posix-shm-read-metadata\n (debug-mode 
entitlement extension process posix-ipc)\n (send-signal report no-report 
deprecated rootless)\n #f\n 47 45 44 41 40 0)\n (ipc-posix-shm-write*\n 
(debug-mode entitlement extension process posix-ipc)\n (send-signal report no- 
report deprecated rootless)\n #f\n 48 44 41 40 0)\n (ipc-posix-shm-write- 
create\n (debug-mode entitlement extension process posix-ipc)\n (send-signal 
report no-report deprecated rootless)\n #f\n 49 48 44 41 40 0)\n (ipc-posix- 
shm-write-data\n (debug-mode entitlement extension process posix-ipc)\n 
(send-signal report no-report deprecated rootless)\n #f\n 50 48 44 41 40 0)\n 
(ipc-posix-shm-write-unlink\n (debug-mode entitlement extension process posix- 
ipc)\n (send-signal report no-report deprecated rootless)\n #f\n 51 48 44 
41 40 0)\n (ipc-sysv*\n (debug-mode entitlement extension process)\n (send- 
signal report no-report deprecated rootless)\n #f\n 52 40 0)\n (ipc-sysv- 
msg\n (debug-mode entitlement extension process)\n (send-signal report no- 



report deprecated rootless)\n #f\n 53 52 40 0)\n (ipc-sysv-sem\n (debug- 
mode entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n #f\n 54 52 40 0)\n (ipc-sysv-shm\n (debug-mode entitlement 
extension process)\n (send-signal report no-report deprecated rootless)\n 
#f\n 55 52 40 0)\n ( job-creation\n (debug-mode entitlement extension 

process path)\n (send-signal report no-report deprecated rootless)\n deny\n 
56 0)\n (load-unsigned-code\n (debug-mode entitlement extension process path)\n 
(send-signal report no-report deprecated rootless)\n #f\n 57 0)\n (lsopen\n 

(debug-mode entitlement extension process)\n (send-signal report no-report 
deprecated rootless)\n #f\n 58 0)\n (mach*\n (debug-mode entitlement 
extension process)\n (send-signal report no-report deprecated rootless)\n 
#f\n 59 0)\n (mach-bootstrap\n (debug-mode entitlement extension process)\n 
(send-signal report no-report deprecated rootless)\n #f\n 60 59 0)\n (mach- 

issue-extension\n (debug-mode entitlement extension process mach extension- 
class)\n (send-signal report no-report deprecated rootless)\n #f\n 61 59 
0)\n (mach-lookup\n (debug-mode entitlement extension process mach)\n (send- 
signal report no-report deprecated rootless)\n #f\n 62 59 0)\n (mach-per- 
user-lookup\n (debug-mode entitlement extension process)\n (send-signal 
report no-report deprecated rootless)\n #f\n 63 59 0)\n (mach-priv*\n 
(debug-mode entitlement extension process)\n (send-signal report no-report 
deprecated rootless)\n #f\n 64 59 0)\n (mach-priv-host-port\n (debug-mode 
entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n #f\n 65 64 59 0)\n (mach-priv-task-port\n (debug-mode 
entitlement extension process path)\n (send-signal report no-report deprecated 
rootless)\n #f\n 66 64 59 0)\n (mach-register\n (debug-mode entitlement 
extension process mach)\n (send-signal report no-report deprecated rootless)\n 
#f\n 67 59 0)\n (mach-task-name\n (debug-mode entitlement extension 
process)\n (send-signal report no-report deprecated rootless)\n #f\n 68 59 
0)\n (network*\n (debug-mode entitlement extension process socket network path 
file-mode vnode-type)\n (send-signal report no-report deprecated rootless)\n 
#f\n 69 0)\n (network-inbound\n (debug-mode entitlement extension process 
socket network path file-mode vnode-type)\n (send-signal report no-report 
deprecated rootless)\n #f\n 70 69 0)\n (network-bind\n (debug-mode 
entitlement extension process socket network path file-mode vnode-type)\n (send- 
signal report no-report deprecated rootless)\n #f\n 71 70 69 0)\n (network- 
outbound\n (debug-mode entitlement extension process socket network path file- 
mode vnode-type)\n (send-signal report no-report deprecated rootless)\n #f\n 
72 69 0)\n (user-preference*\n (debug-mode entitlement extension process 
preference-domain)\n (send-signal report no-report deprecated rootless)\n 
#f\n 73 0)\n (user-preference-read\n (debug-mode entitlement extension 
process preference-domain)\n (send-signal report no-report deprecated 
rootless)\n #f\n 74 73 0)\n (user-preference-write\n (debug-mode 
entitlement extension process preference-domain)\n (send-signal report no-report 
deprecated rootless)\n #f\n 75 73 0)\n (process*\n (debug-mode 
entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n #f\n 76 0)\n (process-exec*\n (debug-mode entitlement 
extension process path file-mode)\n (send-signal report no-report deprecated 
rootless no-sandbox)\n #f\n 77 76 0)\n (process-exec-interpreter\n 
(debug-mode entitlement extension process path file-mode)\n (send-signal report 
no-report deprecated rootless no-sandbox)\n #f\n 78 77 76 0)\n (process- 
fork\n (debug-mode entitlement extension process)\n (send-signal report no- 
report deprecated rootless)\n #f\n 79 76 0)\n (process-info*\n (debug- 
mode entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n allow\n 80 76 0)\n (process-info-listpids\n (debug-mode 
entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n #f\n 81 80 76 0)\n (process-info-pidinfo\n (debug-mode 
entitlement extension process target)\n (send-signal report no-report deprecated 
rootless)\n #f\n 82 80 76 0)\n (process-info-pidfdinfo\n (debug-mode 
entitlement extension process target)\n (send-signal report no-report deprecated 



rootless)\n #f\n 83 80 76 0)\n (process-info-pidfileportinfo\n (debug- 
mode entitlement extension process target)\n (send-signal report no-report 
deprecated rootless)\n #f\n 84 80 76 0)\n (process-info-setcontrol\n 
(debug-mode entitlement extension process target)\n (send-signal report no- 
report deprecated rootless)\n #f\n 85 80 76 0)\n (process-info- 
dirtycontrol\n (debug-mode entitlement extension process target)\n (send- 
signal report no-report deprecated rootless)\n #f\n 86 80 76 0)\n (process- 

info-rusage\n (debug-mode entitlement extension process target)\n (send- 
signal report no-report deprecated rootless)\n #f\n 87 80 76 0)\n (pseudo- 

tty\n (debug-mode entitlement extension process)\n (send-signal report no- 
report deprecated rootless)\n #f\n 88 0)\n (signal\n (debug-mode 
entitlement extension process target)\n (send-signal report no-report deprecated 
rootless)\n #f\n 89 0)\n (sysctl*\n (debug-mode entitlement extension 
process sysctl)\n (send-signal report no-report deprecated rootless)\n #f\n 
90 0)\n (sysctl-read\n (debug-mode entitlement extension process sysctl)\n 
(send-signal report no-report deprecated rootless)\n #f\n 91 90 0)\n 

(sysctl-write\n (debug-mode entitlement extension process sysctl)\n (send- 
signal report no-report deprecated rootless)\n #f\n 92 90 0)\n (system*\n 

(debug-mode entitlement extension process)\n (send-signal report no-report 
deprecated rootless)\n #f\n 93 0)\n (system-acct\n (debug-mode 
entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n #f\n 94 93 0)\n (system-audit\n (debug-mode entitlement 

extension process)\n (send-signal report no-report deprecated rootless)\n 
#f\n 95 93 0)\n (system-chud\n (debug-mode entitlement extension process)\n 
(send-signal report no-report deprecated rootless)\n #f\n 96 93 0)\n 

(system-debug\n (debug-mode entitlement extension process)\n (send-signal 
report no-report deprecated rootless)\n #f\n 97 93 0)\n (system-f sctl\n 
(debug-mode entitlement extension process fsctl)\n (send-signal report no-report 
deprecated rootless)\n #f\n 98 93 0)\n (system-info\n (debug-mode 
entitlement extension process info)\n (send-signal report no-report deprecated 
rootless)\n #f\n 99 93 0)\n (system-kext*\n (debug-mode entitlement 

extension process kext-bundle-id)\n (send-signal report no-report deprecated 
rootless)\n #f\n 100 93 0)\n (system-kext-load\n (debug-mode entitlement 

extension process kext-bundle-id)\n (send-signal report no-report deprecated 
rootless)\n #f\n 101 100 93 0)\n (system-kext-unload\n (debug-mode 
entitlement extension process kext-bundle-id)\n (send-signal report no-report 
deprecated rootless)\n #f\n 102 100 93 0)\n (system-lcid\n (debug-mode 
entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n #f\n 103 93 0)\n (system-mac-label\n (debug-mode entitlement 

extension process)\n (send-signal report no-report deprecated rootless)\n 
#f\n 104 93 0)\n (system-nf ssvc\n (debug-mode entitlement extension 

process)\n (send-signal report no-report deprecated rootless)\n #f\n 105 

93 0)\n (system-privilegeXn (debug-mode entitlement extension process priv)\n 
(send-signal report no-report deprecated rootless grant)\n allow\n 106 93 
0)\n (system-reboot\n (debug-mode entitlement extension process)\n (send- 
signal report no-report deprecated rootless)\n #f\n 107 93 0)\n (system- 

sched\n (debug-mode entitlement extension process)\n (send-signal report no- 
report deprecated rootless)\n #f\n 108 93 0)\n (system-set-time\n (debug- 
mode entitlement extension process)\n (send-signal report no-report deprecated 
rootless)\n #f\n 109 93 0)\n (system-socket\n (debug-mode entitlement 
extension process socket)\n (send-signal report no-report deprecated rootless)\n 
#f\n 110 93 0)\n (system-suspend-resume\n (debug-mode entitlement extension 
process)\n (send-signal report no-report deprecated rootless)\n #f\n 111 

93 0)\n (system-swap\n (debug-mode entitlement extension process)\n (send- 
signal report no-report deprecated rootless)\n #f\n 112 93 0)\n (system- 

write-bootstrap\n (debug-mode entitlement extension process)\n (send-signal 
report no-report deprecated rootless)\n #f\n 113 93 0))\n\n;;; Filters\n\n; ; 

Filters have the form (filter type merge name . args)\n;; e.g. (filter path 0 

literal \"foo\" )\n(define %f/type cadr) ; filter type\n(define 



%f/merge caddr) ; filter merge argument\n(define %f/name cadddr) 

; filter name\n(define %f/args cddddr) ; filter arguments\n\n; ; The 

%filter function produces a generic filter from its name, type, the\n;; number of 
unrepeatable arguments to the filter, whether the filter can be\n;; merged with 
similar filters given its arguments, a function that checks the\n;; filter's 
arguments, and a function that processes the filter's arguments . \n(define (%filter 
name type limit merge test process)\n (lambda args\n (if (test args)\n 
(let ((processed (process args))\n (merge-count (and merge limit)))\n 

(if (and (not merge)\n (> (length processed)\n 

(+ limit l)))\n (apply require-any\n (map (lambda 

(arg)\n '(filter , type\n 

, merge-count\n , name\n 

,§(take processed limit)\n ,arg))\n 

(drop processed limit)))\n '(filter , type , merge-count , name . 

, processed) ) )\n (error (string-append\n \"malformed \"\n 

(symbol->string type)\n \" filter\" ) ) ) ) )\n\n; ; Define a pair of 

standard string filters given a type, name, and the\n;; identifiers for the literal 
and regex versions of the filter . \n(macro (%string-filter form)\n (let* ((ps (cdr 
form))\n (type (car ps))\n (name (cadr ps))\n (literal-id 

(caddr ps))\n (regex-id (cadddr ps))\n (test (lambda (args)\n 

(and (<= 1 (length args))\n (%every string? args))))\n 

(process (lambda (class)\n (lambda (arg)\n 

(cons class arg)))))\n '(begin\n , (if literal-id\n '(define 

, literal-id , (%filter name type 1 #f test (process 1 literal) )) )\n , (if regex- 

id\n '(define , regex-id , (%filter name type 1 #t test (process 

'regex)))))))\n\n; ; The %every predicate checks whether every element in a list 
satisfies a\n;; predicate. Useful for functions that check filter 
arguments. \n(define (%every pred ls)\n (cond\n ((null? ls)\n #t)\n ((pred 
(car ls))\n (%every pred (cdr ls)))\n (else\n #f)))\n\n;; The %id function 
is the identity function. Useful for functions that\n;; process filter 
arguments . \n(define (%id x)\n x)\n\n;; Define combination filters . \n(define 
(%combination-filter name merges)\n (define (create left right)\n (list 'filter 
'combination #f name left right ))\n ;; Return elements of list b that aren't in 

list a.\n (define (set-subtract a b)\n (cond ((null? a) '())\n 
((member (car a) b) (set-subtract (cdr a) b))\n (else (cons (car a) (set- 

subtract (cdr a) b)))))\n ;; Merge two filters. \n (define (merge left right)\n 

(cond\n ((and merges\n (%f /merge left)\n (%f /merge right)\n 

(eq? (%f/name left)\n (%f/name right)))\n ;; Merge the filters 

directly by combining their argument lists. \n (append left (set-subtract (drop 

(%f/args right)\n (%f/merge right))\n 

left)))\n ((eq? name (%f/name right))\n ;; Recursively merge with an 

existing combination filter. \n (let ((right-left (car (%f/args right)))\n 

(right-right (cadr (%f/args right))))\n (if (and (%f/merge right-left)\n 

(eq? (%f/name left)\n (%f/name right-left)))\n 

(create (merge left right-left)\n right-right)\n 

(create right-left (merge left right-right) ))) )\n (else\n ;; Merge the 

filters by creating a new combination filter. \n (create left right))))\n 

(lambda args\n (let combine ((rest args))\n (cond\n ;; Verify that 

the filter has at least one argument. \n ((null? rest)\n (error 

(string-append\n (symbol->string name)\n \" requires 

at least one filter\")))\n ;; Verify that the arguments are filters. \n 

((not (and (pair? (car rest))\n (eq? 'filter (caar rest))))\n 

(error (string-append\n V'arguments to \"\n (symbol- 

>string name)\n \" must be filters'^" ) ) )\n ;; If there's only 

one argument, return it directly. \n ((null? (cdr rest))\n (car 

rest))\n ;; Expand trees of combination filters to the right. \n ;; This 

is not necessary, but it allows better merging of filters. \n ((eq? name 

(%f/name (car rest)))\n (combine (list (car (%f/args (car rest)))\n 

(combine (cons (cadr (%f/args (car rest)))\n 



(cdr rest) ) ) ) ) )\n ;; Recursively merge pairs of arguments. \n (else\n 

(merge (car rest)\n (combine (cdr rest) )))))) )\n(define require-all 

(%combination-filter 'require-all #f ) )\n(define require-any (%combination-filter 
'require-any #t) )\n(define require-not\n (%filter 1 require-not\n 
' combination\n 0 ; no unrepeatable arguments\n 

#f ; arguments can not be merged\n (lambda 

(args) ; one filter argument\n (and (= 1 (length args))\n 

(pair? (car args))\n (eq? 'filter (caar args))))\n %id)) 

; no argument processing\n\n; ; Define entitlement filters . \n(define %entitlement- 
load\n (%filter ' entitlement-load\n ' entitlements 0 

; no unrepeatable arguments\n #f ; arguments 

can not be merged\n (lambda (args) ; one or more string 

arguments'^ (and (= 1 (length args))\n (%every string? 

args)))\n %id) )\n\n(%string-filter entitlements 

entitlement -compare -strings %entitlement-string\n 

%entitlement-regex)\n\n(define %entitlement-boolean\n (%filter ' entitlement- 
compare-boolS ' entitlements 0 ; no 

unrepeatable arguments'^ #f ; arguments can not 

be mergedS (lambda (args) ; zero or one boolean arguments 

(and (>= 1 (length args))\n (%every boolean? args)))\n 

(lambda (args) ; provide default arguments (if (zero? 

(length args))\n '(#t)\n args) ) ) )\n\n(define 

(entitlement-value arg)\n (cond ((string? arg) (%entitlement-string arg))\n 
((boolean? arg) (%entitlement-boolean arg))\n (else (error V'entitlement- 

value argument must be string or booleanV ) ) ) )\n\n(define (entitlement-value-regex 
arg)\n (cond ((string? arg) (%entitlement-regex arg))\n (else 

(error V'entitlement-value-regex argument must be stringV' ) ) ) )\n\n(define (require- 
entitlement entitlement-name . args)\n (let ((numargs (length args)))\n (cond 
((zero? numargs) ( require-entitlement entitlement-name (%entitlement-boolean 
#t)))\n ((= 1 numargs)\n (let ((value-filter (car args)))\n 

(if (and (pair? value-filter )\n (eq? 'filter (car value- 

filter) ))\n (list 'filter 'combination #f 'require-entitlement \n 

(%entitlement-load entitlement-name)\n value-filter )\n 

(error V'expected filter as second argument\"))))\n (else (error \"too 

many arguments to require-entitlementV' ) ) ) ) )\n\n; ; Define path filters . \n(%string- 
filter paths path\n literal\n 

regex)\n(define subpath\n (%filter 'path\n 'path\n 1 

; one unrepeatable argument\n #f ; arguments 

can not be merged\n (lambda (args) ; one or more string 

arguments'^ (and (<= 1 (length args))\n (%every 

string? args)\n (%every (lambda (arg)\n 

(let ((len (string-length arg)))\n (if (and (< 1 

len)\n (eqv? #\\/ (string-ref arg (- len 

l))))\n (error \"subpaths must not end with a 

slashV ) )\n (< 0 len)))\n 

args)))\n (lambda (args)\n (cons 'subpath args) ) ) )\n(%string- 

filter path\n mount-relative-path\n mount-relative- 

literal\n mount-relative-regex)\n(define rootless-file-filter\n 

(%filter ' rootless-file\n 'path\n 

0 ; no unrepeatable arguments'^ #f 

; arguments can not be merged\n null? ; no 

arguments'^ %id)) ; no argument 

processing\n(define rootless-mach-filter\n (%filter 1 rootless-mach\n 
'path\n 0 ; no unrepeatable arguments'^ 

#f ; arguments can not be merged\n null? 

; no arguments'^ %id)) ; no argument 

processing\n\n; ; Define xattr filter . \n(%string-filter xattr\n 

xattr\n xattr\n xattr-regex)\n\n; ; Define file-mode 

filter . \n(define file-mode\n (%filter 'file-mode\n 'file-mode\n 



0 ; no unrepeatable arguments'^ #f 

; arguments can not be merged\n (lambda (args) ; one or 

more mode arguments'^ (and (<= 1 (length args))\n 

(%every (lambda (x)\n (and (integer? x)\n 

(<= 0 x #07777 ) ) )\n argsj))\n %id)) 

; no argument processing\n\n; ; Define extension filters . \n(define extension\n 
(%filter 'extension\n 'extension\n 0 

; no unrepeatable arguments'^ #f ; arguments 

can not be merged\n (lambda (args) ; zero or more string 

arguments'^ (%every string? args))\n (lambda (args) 

; provide a default argument\n (if (zero? (length args))\n 

1 ( \"com. apple. app- sandbox. read- write\")\n 
ar 9 s ) ) ) )\n(%string-filter extension-class\n extension-class\n 

extension-class\n extension-class-regex)\n\n; ; Define vnode-type 

filter .\n(define vnode-type\n (%filter 1 vnode-type\n 1 vnode-type\n 

0 ; no unrepeatable arguments'^ #f 

; arguments can not be merged\n (lambda (args) ; one or 

more vnode type arguments'^ (and (<= 1 (length args))\n 

(%every (lambda (x)\n (memq x '(REGULAR-FILE DIRECTORY 

BLOCK-DEVICE CHARACTER- DEVICE SYMLINK SOCKET FIFO TTY)))\n 

args)))\n %id)) ; no argument processing\n(define 

REGULAR-FILE 'REGULAR-FILE) (define DIRECTORY 'DIRECTORY )\n(define 

BLOCK-DEVICE 'BLOCK-DEVICE) (define CHARACTER- DEVICE ' CHARACTER-DEVICE)\n(define 
SYMLINK 'SYMLINK ) (define SOCKET 'SOCKET )\n(define 

FIFO 'FIFO ) (define TTY 'TTY )\n\n ; ; 

Define debug-mode filter . \n(define debug-mode\n (%filter ' debug-mode\n 
' debug-mode\n 0 ; no unrepeatable arguments\n 

#f ; arguments can not be merged\n null? 

; no arguments'^ %id)) ; no argument 

processing\n\n; ; Define POSIX IPC filters . \n(%string-filter posix-ipc\n 
ipc-posix-name\n ipc-posix-name\n ipc-posix-name- 

regex)\n\n;; Define Mach filters . \n(%string-filter mach\n global - 

name\n global-name\n global-name-regex)\n(%string- 

filter mach\n local-name\n local-name\n 

local-name-regex)\n\n; ; Define KEXT filters . \n(%string-filter kext-bundle-id\n 
kext-bundle-id\n kext-bundle-id\n kext-bundle-id- 

regex)\n\n;; Define network filters . \n(define (%network-filter name)\n (%filter 
name\n 'network\n 1 ; one 

unrepeatable argument\n #f ; arguments can not 

be merged\n (lambda (args) ; one protocol argument followed 

by\n (and (<= 1 (length args)) ; zero or more string arguments\n 

(memq (car args)\n '(ip ip4 ip6 tcp tcp4 tcp6 udp udp4 

udp6))\n (%every string? (cdr args))))\n (lambda (args) 

; provide a default string argument\n (if (= 1 (length args))\n 

(append args ' (V* : *\" ) )\n args) ) ) )\n(define (%network-legacy- 

filter network-filter )\n (lambda args\n (if (and (<= 1 (length args))\n 
(eq? 'unix (car args)))\n (if (pair? (cdr args))\n (apply regex 

(cdr args))\n (regex \"\"))\n (apply network-filter 

ar QS) ) ) )\n(define local (%network-legacy-filter (%network-filter 
'local )))\n(define remote (%network-legacy-filter (%network-filter 
' remote) ) )\n(define unix ' unix)\n(define ip 'ip ) (define ip4 'ip4 ) (define 
ip6 'ip6 )\n(define tcp 'tcp ) (define tcp4 'tcp4) (define tcp6 ' tcp6)\n(define 
udp 'udp ) (define udp4 'udp4) (define udp6 ' udp6)\n(%string-filter network 
control-name control-name control-name-regex)\n\n; ; Define socket filters . \n(define 
socket-domain\n (%filter ' socket-domain\n 'socket\n 0 

; no unrepeatable arguments\n #f ; arguments 

can not be merged\n (lambda (args) ; one or more numeric 

arguments'^ (and (<= 1 (length args))\n (%every 

(lambda (arg)\n (and (integer? arg)\n 



(< -1 arg AF_MAX)))\n args)))\n %id)) 

; no argument processing\n(define socket-type\n (%filter ' socket-type\n 
'socket\n 0 ; no unrepeatable arguments'^ 

#f ; arguments can not be merged\n (lambda 

(args) ; one or more numeric arguments'^ (and (<= 1 

(length args))\n (%every integer? args)))\n %id)) 

; no argument processing\n(define socket-protocol\n (%filter 1 socket-protocol\n 
'socket\n 0 ; no unrepeatable arguments'^ 

#f ; arguments can not be merged\n (lambda 

(args) ; one or more numeric arguments'^ (and (<= 1 

(length args))\n (%every integer? args)))\n %id)) 

; no argument processing\n\n; ; Define process target filters . \n(define target\n 
(%filter 'target\n 'target\n 0 ; no 

unrepeatable arguments'^ #f ; arguments can not 

be merged\n (lambda (args) ; one or more target arguments'^ 

(and (<= 1 (length args))\n (%every (lambda (arg)\n 

(memq arg '(self pgrp others children same-sandbox) ) )\n 

args)))\n %id)) ; no argument processing\n(define 

self ' self )\n(define pgrp ' pgrp)\n(define others ' others)\n(define 
children 1 children)\n(define same-sandbox 1 same-sandbox)\n\n; ; Define semaphore 
filters. \n(define semaphore-owner\n (%filter ' semaphore-owner\n 
' semaphored 0 ; no unrepeatable arguments\n 

#f ; arguments can not be merged\n (lambda 

(args) ; one or more target arguments'^ (and (<= 1 

(length args))\n (%every (lambda (arg)\n 

(memq arg '(self pgrp others children same-sandbox) ) )\n 

args)))\n %id)) ; no argument processing\n\n; ; 

Define fsctl filters . \n(define f sctl-command\n (%filter ' f sctl-command\n 
'fsctl\n 0 ; no unrepeatable arguments'^ 

#f ; arguments can not be merged\n (lambda 

(args) ; one or more numeric arguments'^ (and (<= 1 

(length args))\n (%every integer? args)))\n %id)) 

; no argument processing\n\n; ; Define ioctl filters . \n(define ioctl-command\n 
(%filter 1 ioctl-command\n 'ioctl\n 0 

; no unrepeatable arguments'^ #f ; arguments 

can not be merged\n (lambda (args) ; one or more numeric 

arguments'^ (and (<= 1 (length args))\n (%every 

integer? args)))\n %id)) ; no argument 

processing\n\n; ; Helper function for composing fsctl / ioctl commands . \n(define 
(_IO g n)\n (+ n (* 256 (char->integer (car (string->list g) ) ) ) ) )\n\n; ; Define 
I/O Kit filters . \n(%string-filter iokit-user-client\n iokit-user- 

client-class\n iokit-user-client-class\n iokit-user- 

client-class-regex)\n(%string-filter iokit-property\n iokit- 

property\n iokit-property\n iokit-property- 

regex)\n(%string-filter iokit-connection\n iokit-connection\n 

iokit-connection\n iokit-connection-regex)\n\n; ; Define device 

filters . \n(define device-major\n (%filter 1 device-major\n 'device\n 

0 ; no unrepeatable arguments'^ #f 

; arguments can not be merged\n (lambda (args) ; one or 

more numeric arguments'^ (and (<= 1 (length args))\n 

(%every integer? args)))\n %id)) ; no argument 

processing\n(define device-minor\n (%filter 1 device-minor\n 'device\n 

0 ; no unrepeatable arguments'^ #f 

; arguments can not be merged\n (lambda (args) ; one or 

more numeric arguments'^ (and (<= 1 (length args))\n 

(%every integer? args)))\n %id)) ; no argument 

processing\n(define device-conforms-to\n (%filter 1 device-conforms-to\n 
'device\n 0 ; no unrepeatable arguments'^ 

#f ; arguments can not be merged\n (lambda 



(args) ; one or more string argumentsS (and (= 1 (length 

args))\n (%every string? args)))\n %id))\n 

\n\n;; Define Apple Event filters . \n(%string-filter ae-destination\n 
appleevent -destinations appleevent -destinations 

appleevent-destination-regex)\n\n; ; Define Authorization Services right 
filters. \n(%string-filter auth-right-name\n right-name\n 

right-name\n right-name-regex)\n\n; ; Define Preference 

filters . \n(%st ring -filter preference -domains preference -domains 

preference-domains preference-domain-regex)\n\n; ; Define Info 

filters . \n(%string-filter info\n info-type\n info- 

type\n #f)\n\n;; Define notification filters . \n(%string-filter 

notifications notification-nameS notification- 

name\n 


notification-name-regex)\n( define notification -payloadS (%filter 


; arguments 
no argumentsS 
Define privilege 
1 priv\n 
#f 


no argument 


1 notification-payloadS 1 notifications 

; no unrepeatable argumentsS #f 

can not be mergedS null? 

%id)) ; no argument processing\n\n; ; 

filters . \n(define privilege-idS (%filter 1 privilege-id\n 

0 ; no unrepeatable argumentsS 

; arguments can not be mergedS (lambda (args) 

more numeric argumentsS (and (<= 1 (length args))\n 

(%every integer? args)))\n %id)) 

processing\n\n; ; Define sysctl filters . S(%string-filter sysctlS 
sysctl-name\n sysctl-name\n sysctl-name-regex)\n\n; ; 

Define Process filters. \n(%string-filter processS process-nameS 

process -name\n process-name-regex)\n\n( define process- is -pluginS 

(%filter 'process-attributeS 'processS 1 

; one unrepeatable argumentsS #f ; arguments 

can not be mergedS null? ; no caller-supplied 

argumentsS (lambda (args)\n (cons 'is-plugin args) ) ) )\n\n; ; ; 

Modifiers\n\n; ; Modifiers have the form (modifier check name . args)\n;; e.g. 
(modifier #<CLOSURE> send-signal 17)\n(define %m/check cadr) ; 

predicate for action compatibility\n(define %m/name caddr) 


modifier arguments\n\n; ; 

' send-signal\n (lambda args 

(and (= 1 (length args))\n 
(car args)\n 
; applies to all 
'grants (lambda args 

(lambda (rule) 


modifier name\n(define %m/args cdddr) 

Define modifiers. \n(define send-signalS (list 
; one integral argument, legal signals 
(integer? (car args))\n (< 0\n 

DARWIN_NSIG) ) )S (lambda (rule) 

actionsS #t) ) )\n(define grants (list 

; no argumentsS (= 0 (length args)))\n 

; only applies to allows (eq? rule ' allow) )) )\n(define reports (list 

'reports (lambda args ; no argumentsS (= 0 

(length args)))\n (lambda (rule) ; only applies to allows 

(eq? rule ' allow) )) )\n(define no-reportS (list 'no-reportS (lambda args 

; no argumentsS (= 0 (length args)))\n (lambda (rule) 

; only applies to denyS (eq? rule ' deny) ) ) )\n(define no-sandboxS (list 

' no-sandboxS (lambda args ; no argumentsS (= 0 

(length args)))\n (lambda (rule) ; only applies to allows 

(eq? rule ' allow) )) )\n(define no-calloutS (list ' deprecatedS (lambda args 

; no argumentsS (disable-callouts) ; superseded by sandbox 

options (= 0 (length args)))\n (lambda (rule) ; 

applies to all actionsS #t)))\n(define partial-symbolicationS (list 

' deprecatedS (lambda args ; no argumentsS 

(disable-full-symbolication) ; superseded by sandbox options (= 0 

(length args)))\n (lambda (rule) ; applies to all actionsS 

#t) ) )\n(define rootless-modifierS (list ' rootlessS (lambda args 

; no argumentsS (= 0 (length args)))\n (lambda (rule) 

; applies to denyS (eq? rule ' deny) ) ) )\n\n; ; The with function creates a 



modifier .\n(define (with modifier . args)\n ;; Verify that the first argument is 
modifier. \n (if (and (list? modifier)\n (= 3 (length modifier))\n 

(symbol? (car modifier) )\n (procedure? (cadr modifier) )\n 

(procedure? (caddr modifier )) )\n ;; Check the modifier's arguments. \n (if 

(apply (cadr modifier)\n args)\n ;; Create the modifier. \n 

'(modifier , (caddr modifier)\n , (car modifier)\n 

An ,args)\n (error V'malformed modifierA" (car 

modifier )) )\n (error V'illegal modifierV ) ) )\n\n; ; ; Utilities\n\n; ; The %opt- 

remove-filters optimization removes filtered rules that have no\n;; effect on the 
result of profile evaluation . \n(define (%opt-remove-filters)\n ;; Given a rule, if 
it's unfiltered return its action and modifiers, if it's\n ;; filtered return #f, 
and if it's a jump to another operation, operate\n ;; recursively on the first 
rule for the target operation. \n (define (action rule)\n (case (car rule)\n 
((#t) (cdr rule))\n ((#f) (action (car (vector-ref *rules* (cdr rule)))))\n 

(else #f)))\n ;; Iterate over every operation in the rules table from most general 

to least\n ; ; general, because unnecessary rules for more general operations 
would\n ; ; prevent the detection of unnecessary rules for less general 
operations. \n (do ((op 0 (+ op l))\n (count (vector-length *rules*)\n 

count))\n ((= op count))\n ;; If the operation has at least one filtered 

rule and the result of\n ; ; matching the last filtered rule is the same as the 
result of matching\n ; ; none of the filtered rules, remove the last filtered 
rule. There's no\n ;; need to look at more than just the last filtered rule, 
because\n ; ; sequential rules with the same result have already been combined, 
and\n ; ; therefore if the last filtered rule could be eliminated, the one 
before\n ;; it cannot (as it has a different result); and if a rule could not 
be\n ;; eliminated, neither can the one before it (as it determines whether 
the\n ;; later rules will be evaluated) . \n (let ((rules (vector-ref *rules* 
op)))\n (if (< 1 (length rules))\n (let ((reverse-rules (reverse 

rules)))\n (if (equal? (cdadr reverse-rules)\n 

(action (car reverse-rules) ) )\n (vector-set! *rules*\n 

op\n (reverse (cons (car reverse-rules)\n 

(cddr reverse-rules))))))))))\n\n; ; The %opt-remove-duplicates removes duplicate 
rules in chained\n;; combination filters . \n(define (%opt-remove-duplicates)\n\n ;; 
If given a combination filter, returns its type\n ;; (e.g. require-any) , else 
returns #f.\n (define (which-combination filter)\n (if (and (list? filter)\n 
(equal? (car filter) 'filter)\n (equal? (cadr filter) ' combination)\n 

(member (cadddr filter) '(require-any require-all) ) )\n\n (if (not (= (length 

filter) 6))\n (error\n (string-append V'combination filter 

of type A" (cadddr filter)\n V" has wrong length \"\n 

(number->string (length filter ))) )\n\n (cadddr filter))\n\n 

#f))\n\n (define (remove-dups filter)\n ;; remove-dups-progress postorder- 
traverses the filter tree as\n ; ; long as it encounters combination filter nodes 
of the given\n ;; type given in 'type' (e.g. require-any). Whenever it 
encounters\n ; ; a combination filter node of a differing type, it isolatedlyXn 
;; process that subtree with an fresh, initially empty seen-listAn ;; Nodes 
which aren't combination filters at all are just kept\n ;; unchanged or removed 
entirely if already seen in the current\n ;; remove-dups-progress context. \n 
(define (remove-dups-progress filter type seen)\n (let ((this-type (which- 

combination filter) ) )\n\n (if (equal? this-type type)\n ;; If 

called on a filter with the currently processed type,\n ;; dedupe the 

children and inspect the result. \n (let* ((left-pair ( remove-dups- 

progress\n (car (cddddr filter)) type seen))\n 

(left (car left-pair) )\n (left-seen (cdr left-pair) )\n\n 

(right-pair ( remove-dups-progress\n (car (cdr 

(cddddr filter))) type left-seen) )\n (right (car right-pair) )\n 

(right-seen (cdr right-pair )) )\n\n (cond\n ;; If one of 

the two children was completely reduced away\n ; ; by deduplication, 

do not recreate a combination\n ;; filter, but just use the other 

child as new filter\n ;; nodeAn ;; Note that if both 



children were reduced away, this\n ; ; results in the current node 

also being empty. \n ((null? left) (cons right right-seen) )\n 

((null? right) (cons left right-seen) )\n\n ;; Otherwise, recreate a 

combination filter node using the\n ;; two deduped children. \n 

(else (cons (list 'filter 'combination (caddr filter) type left right)\n 
right-seen) )) )\n\n ;; If called on a filter which is either not a 

combination^ ;; filter of the currently processed type ...\n 

(begin\n (let ((filter 1 (if this-type\n 

; ; ... either isolatedly dedupe the\n ; ; subtree if 

it is a combination\n ; ; filter of another 

type ...\n (car ( remove-dups-progress filter\n 

this-type ()))\n 

; ; . . or use it directly if it\n 
;; is not a combination filter at allAn 

filter)))\n ;; This is the actual deduping: the inspected filter 

is\n ; ; reduced away if it was already seen, or kept and\n 

;; added to the seen list if notAn (if (member filter' seen)\n 

(cons () seen)\n (cons filter' (cons filter' seen) )))))) )\n\n 

;; We start on the filter's root node with the never occurring\n ;; type (). If 
the root node is indeed a combination filter, \n ;; remove-dups-progress will 
restart itself with its typeAn (car (remove-dups-progress filter () ())))\n\n 
(do ((op 0 (+ op l))\n (count (vector-length *rules*)\n 

count))\n ((= op count))\n (vector-set! *rules* op\n (map 

(lambda (rule)\n (cons (remove-dups (car rule)) (cdr 

rule)))\n (vector-ref *rules* op) ) ) ) )\n\n; ; The %record 

function converts the evaluated rules back into an SBPL-like\n; ; format to aid in 
debugging complicated sandbox profiles . \n(define (%record)\n ;; Remove unnecessary 
information from the filters before printing. \n (define (process-filter f)\n 
(if (eq? 'combination (%f/type f))\n (cons (%f/name f)\n (map 

process-filter (%f/args f)))\n (cons (%f/name f)\n (%f/args 

f))))\n ;; Iterate over the rules for each operation. \n (do ((op 0 (+ op l))\n 

(count (vector-length *rules*)\n count))\n ((= op count))\n 

(do ((rules (reverse (vector-ref *rules* op))\n (cdr rules)))\n 

((null? rules))\n (if (caar rules)\n (let ((action (cadar rules))\n 

(modifiers (cddar rules)))\n (let write-rule ((filters (caar rules)))\n 

(if (and (pair? filters)\n (eq? 'require-any (%f/name 

filters) ))\n ;; For rules that were combined with a require-any\n 

;; filter, recursively display them as separate rules. \n (begin\n 

(write-rule (cadr (%f/args filters)))\n (write-rule (car 

(%f/args filters) )) )\n ;; Write other rules out in a format 

resembling SBPLAn (begin\n (write (append 

(list action (%o/name (vector-ref ‘operations* op)))\n 
(if (eq? #t filters)\n (list)\n 

(list (process-filter filters) ))\n (map (lambda 

(m)\n (cons 'with (cons (%m/name m)\n 

(%m/args m))))\n modifiers) ) )\n 

(newline) ))))))) )\n\n(define (%emit-implicit-rules)\n ;; Determine if an operation 
can ever return a certain action. \n (define (returns? op action)\n (let scan 
((rules (vector-ref ‘rules* (%o/code op))))\n (cond\n ((not (caar 

rules))\n (scan (vector-ref ‘rules* (cdar rules))))\n ((eq? action 

(cadar rules))\n #t)\n ((pair? (cdr rules))\n (scan (cdr 

rules) ))\n (else\n #f))))\n (define (allowed? op)\n (returns? op 

'allow))\n (define (denied? op)\n (returns? op 'deny))\n ;; Allow mach- 
bootstrap if mach-lookup is ever allowed An (if (or ‘trace* (allowed? mach- 
lookup))\n (allow mach-bootstrap) )\n ;; Allow access to webdavf s_agent if 

file-read* is always allowed. \n ;; <rdar : //problem/6816031> remove workaround for 
6769092\n (if (not (denied? file-read*))\n (allow network-outbound\n 

(regex #\" A /private/tmp/\\.webdavllDS\\. [ A /]+$\")))\n ;; Never allow a sandboxed 

process to open a launchd socket. \n (deny network-outbound\n 



(literal \"/private/var/tmp/launchd/sock\")\n (regex 

#\" A /private/tmp/launchd- [0-9]+\\. [ A /]+/sock$\"))\n ;; Never allow a sandboxed 

process to access sandbox cache directories. \n (let ((count (vector-length 
‘operations* ) ) )\n (do ((op 0 (+ op l)))\n ((= op count))\n (let 

((operation (vector-ref ‘operations* op)))\n (if (and (memq 'path 

(%o/filters operation) )\n (not (memq 'cache-safe (%o/filters 

operation) )) )\n (deny operation (regex 

#\"/com\\ . appleW . sandbox($ | /)\" ) ) ) ) ) )\n ;; Always allow a process to signal 

itself. \n (allow signal (target self ) ) )\n\n; ; The %finalize function is called 
after a profile has been evaluated . \n(set ! %finalize\n (lambda ()\n (if 

(not (param \"N0 IMPLICIT_RULES\" ) ) (%emit-implicit-rules) )\n ;; Optimize 

the profile rules. \n (%opt-remove-filters)\n (if ‘eliminate- 

duplicate-rules* (%opt-remove-duplicates) )\n ;; Dump the evaluated 

profile. \n (if ‘record* (with-output-to-file ‘record* %record))))\n\n; ; ; 

Aliases\n\n(macro (debug args) )\n(define getenv param)\n(define file-fsctl system- 
f sctl)\n(define ipc-posix-shm ipc-posix-shm* )\n(define sysctl-write 
sysctl*)\n(define system-misc system* )\n(define time-set system-set-time)\n(define 
from local)\n(define to remote)\n(define unix-socket unix)\n(define no-profile no- 
sandbox)\n(define no-log no-report)\n(define granted-extensions extension)\n(define 
(container) (extension *ios-sandbox-container* ) )\n(define (executable-bundle) 
(extension *ios-sandbox-executable* ) )\n(define (application-group) (extension *ios- 
sandbox -application- group* ) )\n( define file -issue -extension* file- issue - 
extension)\n(define file-issue-extension-read file-issue-extension)\n(define file- 
issue-extension-write file-issue-extension)\n(define file-unlink file-write- 
unlink)\n(define mach-extension extension)\n(define (tty) (vnode-type 
TTY) )\n(define file-write-mount file-mount )\n(define file-write-unmount file- 
unmount)\n(define file-write-umount file-unmount)\n(define process-exec process- 
exec*)^", 00 



